home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TBUTIL2.LZH / PRINT2.PAS < prev    next >
Pascal/Delphi Source File  |  1984-07-10  |  8KB  |  331 lines
  1. PROGRAM printer;
  2. {
  3.                          JULY 9, 1984
  4.  
  5.     Program to print an ASCII file in a nice way on the printer.
  6.  
  7.     FEATURES:
  8.  
  9.     1)  A header with filename, date, time, and page #.
  10.     2)  Line numbers may be included
  11.     3)  # lines/page may be altered
  12.     4)  Printer parameters for an Epson printer may be modified
  13.     5)  Filename may be given on the program line or through menu
  14.     6)  Wildcards in filename supported
  15.     7)  Multiple files, separated by spaces, supported
  16.     8)  Natural page breaks honored
  17.     9)  Some TURBO  TLIST commands honored (.PA & .CA)
  18.  
  19.  
  20.  
  21.                      Author:       Todd Little
  22.                                    1318 Bullock
  23.                                    Houston, TX  77055
  24.                                    713-984-2055 h
  25.                                    578-3210 w
  26.  
  27. }
  28.  
  29. TYPE
  30.    stringtype = STRING[255];
  31.  
  32. VAR
  33.       option,I,n                       : INTEGER;
  34.       year                             : INTEGER;
  35.       month,date,day,hour,min          : BYTE;
  36.       want_header,want_line_no,
  37.       want_date,want_time,want_day     : BOOLEAN;
  38.       no_lines                         : INTEGER;
  39.       was_psp                          : BOOLEAN;
  40.       psp                              : STRING[255];
  41.       es,bx                            : INTEGER;
  42.       dta                              : ARRAY [0..127] OF BYTE;
  43.       al                               : BYTE;
  44.       file_search,filename             : stringtype;
  45.  
  46. TYPE
  47.    mnames = ARRAY[1..12] OF STRING[3];
  48.  
  49. CONST
  50.    nmonth: mnames = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
  51.                      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
  52.  
  53. {$i checkpsp.inc}
  54. {$i getdate.inc}
  55. {$i dta.inc}
  56.  
  57. PROCEDURE setprint;
  58.    TYPE
  59.       line_size_type  = ARRAY[1..4] OF STRING[10];
  60.       epson_ls_type   = ARRAY[1..4] OF STRING[1];
  61.       char_type       = ARRAY[1..7] OF STRING[10];
  62.       epson_char_type = ARRAY[1..7] OF STRING[2];
  63.       intern_type     = ARRAY[1..8] OF STRING[10];
  64.    VAR
  65.       I,n: INTEGER;
  66.       rsp: STRING[1];
  67.  
  68.    CONST
  69.       line_size: line_size_type =('1/6"','1/8"','n/72"','n/216"');
  70.       epson_ls:  epson_ls_type  =('2'  ,  '0'  ,  'A'  ,  '3'   );
  71.  
  72.       chars: char_type           =('Pica','Elite','Condensed','Enlarged',
  73.             'Enhanced','Double Hit','Silent');
  74.       epson_char: epson_char_type=( 'P'  ,  'M' ,   #15    ,    'W1'   ,
  75.                'E'    ,     'G'   ,     'S');
  76.  
  77.       intern: intern_type=('French','German','British','Danish','Swedish',
  78.           'Italian','Spanish','Japanese');
  79.  
  80.       epson_intern = 'R';
  81.       blk  = ' ';
  82.       esc  = #27;
  83.  
  84.    BEGIN
  85.  
  86.       CLRSCR;
  87.       WRITE(LST,esc,'@');  {initialize printer}
  88.       i:=0;
  89.  
  90.       rsp := 'n';
  91.       WRITELN;
  92.       WRITELN('Enter a line spacing by typing   Y  or  y  ');
  93.       WRITELN('for the appropriate choice');
  94.       WRITELN;
  95.       WRITELN;
  96.       WHILE  UPCASE(rsp) <> 'Y' DO
  97.       BEGIN
  98.          i:=i MOD 4 +1;
  99.          WRITELN;WRITELN;
  100.          WRITE(line_size[i],' ? ');
  101.          READLN(rsp);
  102.          IF LENGTH(rsp) = 0 THEN
  103.             rsp := 'n';
  104.       END;
  105.  
  106.       IF i > 2 THEN
  107.       BEGIN
  108.          WRITE('Enter "n" ?');
  109.          READLN (n);
  110.          WRITE(LST,esc,epson_ls[i],CHAR(n));
  111.          END
  112.  
  113.       ELSE
  114.          WRITE(LST,esc,epson_ls[i]);
  115.  
  116.       WRITELN;
  117.       WRITELN;
  118.       WRITELN('For all of the following that are appropriate, ');
  119.       WRITELN('enter a   Y   or  y ');
  120.       WRITELN;
  121.  
  122.       FOR i:=1 TO 6 DO
  123.       BEGIN
  124.          WRITE(chars[i],' ?  ');
  125.          READLN(rsp);
  126.          IF LENGTH(rsp) = 1 THEN
  127.             IF  UPCASE(rsp) = 'Y'  THEN
  128.             WRITE(LST,esc,epson_char[i]);
  129.          END;
  130.  
  131.  
  132.       WRITE(  'Select International Character Set  ?');
  133.       READLN(rsp);
  134.       IF LENGTH (rsp) = 1 THEN
  135.          IF UPCASE(rsp) = 'Y' THEN
  136.       BEGIN
  137.          FOR i:=1 TO 8 DO
  138.          BEGIN
  139.            WRITELN(i,':  ',intern[i]);
  140.            END;
  141.          WRITE('Enter number of international character set ');
  142.          READLN(n);
  143.          WRITE(LST,esc,epson_intern,CHAR(n));
  144.          END;
  145. END;
  146.  
  147.  
  148. PROCEDURE list;
  149.    VAR
  150.       line: STRING[255];
  151.       str_num : STRING[4];
  152.       filvar: TEXT;
  153.       I,n,need_line,res: INTEGER;
  154. BEGIN
  155.  
  156.    ASSIGN(filvar,filename);
  157.    RESET(filvar);
  158.    i:=0;
  159.    n:=0;
  160.    WHILE NOT EOF(filvar) DO
  161.    BEGIN
  162.       READLN(filvar,line);
  163.  
  164.       IF (POS('{.CP',line)  = 1) THEN
  165.          BEGIN
  166.          str_num := COPY( line, 5, POS( '}',line )-5 ) ;
  167.          VAL( str_num, need_line, res);
  168.          DELETE( line, 1, 80 );
  169.          IF need_line + i >= no_lines THEN line := COPY(#12,1,1);
  170.          END;
  171.  
  172.       IF (POS('{.PA}',line) = 1) THEN
  173.          BEGIN
  174.          DELETE( line, 1, 80 );
  175.          line := COPY(#12, 1, 1);
  176.          END;
  177.  
  178.  
  179.       IF (POS(#12,line) <> 0) THEN
  180.          BEGIN
  181.          i := 0;
  182.          DELETE (line,POS(#12,line),1);
  183.          END;
  184.  
  185.       IF i MOD no_lines  = 0 THEN
  186.       BEGIN
  187.          n:=n+1;
  188.          IF n <> 1 THEN WRITE(LST,CHAR(12));
  189.          IF (want_header) THEN
  190.          BEGIN
  191.             WRITE(LST,' ':3,CHAR(14),filename:14,CHAR(20),' ':5);
  192.  
  193.             IF (want_date) THEN
  194. {               write(LST,month:2,'/',date:2,'/',year:2,' ':5); }
  195.                WRITE(LST,nmonth[month]:3,' ',date:2,', ',year:4,' ':4);
  196.  
  197.             IF (want_time) THEN
  198.                WRITE(LST,hour:2,':',(min DIV 10):1,(min MOD 10):1);
  199.  
  200.             WRITELN(LST,CHAR(14),'  Page ':8,n:2);
  201.             WRITELN(LST);
  202.             WRITELN(LST);
  203.          END;
  204.       END;
  205.  
  206.       i:=i+1;
  207.  
  208.       IF (want_line_no)  THEN
  209.            WRITE  (LST,i:4,'    ');
  210.       WRITELN(LST,line);
  211.    END;
  212.    WRITELN(LST,CHAR(12));
  213.    CLOSE(filvar);
  214. END;
  215.  
  216. PROCEDURE parsename;
  217. BEGIN
  218.  
  219.    WHILE LENGTH(psp) <> 0 DO
  220.    BEGIN
  221.       file_search := getword(psp);
  222.       file_search := CONCAT(file_search,CHR(0));
  223.       getfile(file_search);
  224.       save_dta{(es,bx,dta)};
  225.       WHILE LENGTH(filename) <> 0 DO
  226.       BEGIN
  227.          list;
  228.          getdta{(es,bx)};
  229.          restore_dta{(es,bx,dta)};
  230.          getnext;
  231.          save_dta{(es,bx,dta)};
  232.       END;
  233.    END;
  234. END;
  235.  
  236. PROCEDURE fileparms;
  237. VAR
  238.    rsp    : STRING[1];
  239.  
  240. BEGIN
  241.  
  242.    want_line_no := FALSE;
  243.    want_header  := TRUE;
  244.    want_date    := TRUE;
  245.    want_time    := TRUE;
  246.    no_lines     := 55;
  247.  
  248.    CLRSCR;
  249.    WRITE('Number of lines per page : ');
  250.    READLN(no_lines);
  251.  
  252.    WRITE('Line numbers (Y/N)       : ');
  253.    READLN(rsp);
  254.    IF LENGTH(rsp) <> 0 THEN
  255.    want_line_no := UPCASE(rsp) = 'Y';
  256.  
  257.    WRITE('Page header (Y/N)        : ');
  258.    READLN(rsp);
  259.    IF LENGTH(rsp) <> 0 THEN
  260.    want_header := UPCASE(rsp) = 'Y';
  261.  
  262.    IF (want_header) THEN
  263.    BEGIN
  264.  
  265.       WRITE('Date header (Y/N)        : ');
  266.       READLN(rsp);
  267.       IF LENGTH(rsp) <> 0 THEN
  268.       want_date := UPCASE(rsp) = 'Y';
  269.  
  270.       WRITE('Time header (Y/N)        : ');
  271.       READLN(rsp);
  272.       IF LENGTH(rsp) <> 0 THEN
  273.       want_time := UPCASE(rsp) = 'Y';
  274.    END;
  275. END;
  276.  
  277.  
  278. PROCEDURE menu;
  279. BEGIN
  280.    CLRSCR;
  281.    GOTOXY(10,3);
  282.    WRITE('1)  Print file');
  283.    GOTOXY(10,5);
  284.    WRITE('2)  Change printer attributes');
  285.    GOTOXY(10,7);
  286.    WRITE('3)  Change print file attributes');
  287.    GOTOXY(10,9);
  288.    WRITE('4)  Stop');
  289.    GOTOXY(20,21);
  290.    WRITE('Enter option  ');
  291.    READ(option);
  292.    END;
  293.  
  294.  
  295. BEGIN
  296.  
  297.    want_line_no := FALSE;
  298.    want_header  := TRUE;
  299.    want_date    := TRUE;
  300.    want_time    := TRUE;
  301.    no_lines     := 55;
  302.    option:=1;
  303.  
  304.    getdate(year,month,date,hour,min);
  305.  
  306.    checkpsp(was_psp,psp);
  307.    getdta{(es,bx)};
  308.  
  309.    IF was_psp THEN
  310.    BEGIN
  311.       parsename;
  312.       option := 4;
  313.       END;
  314.  
  315.    WHILE  option <> 4 DO
  316.    BEGIN
  317.       menu;
  318.       IF(option =  2) THEN  setprint;
  319.       IF(option =  3) THEN  fileparms;
  320.       IF(option =  1) THEN
  321.       BEGIN
  322.         CLRSCR;
  323.         WRITE('Enter name of file: ');
  324.         READLN(psp);
  325.         parsename;
  326.       END;
  327.    END;
  328. end.
  329.  
  330.  
  331.